#!/usr/bin/perl

######################################################################
package Swignition::uF;
######################################################################

use Swignition::DTParse;
use Swignition::GenericParser::Utils;
use Swignition::MagicDuration;
use Swignition::MagicString;
use Swignition::uF::hEvent;
use Swignition::uF::hMeasure;
use Swignition::uF::RelLicense;
use Swignition::uF::RelTag;
use DateTime;
use DateTime::Format::Natural;
use DateTime::Format::Strptime;
use Exporter;
use HTTP::Date;
use URI::URL;
use XML::LibXML qw(:all);
use strict;

our $SGNM;

BEGIN
{
	our @ISA    = qw(Exporter);
	our @EXPORT = qw(destroyer destroy_element data_patterns simple_parse UIDURI);
	
	our $SocialGraph_NodeMapper_available = 1;
	eval 'use SocialGraph::NodeMapper';
	$SocialGraph_NodeMapper_available = 0 if $@;
}

sub getSGNM
{
	return unless ($Swignition::uF::SocialGraph_NodeMapper_available);

	if (! $Swignition::uF::SGNM)
	{
		my $jsfile = __FILE__;
		$jsfile =~ s|uF.pm|ext/nodemapper.js|;
		$SGNM = SocialGraph::NodeMapper->new($jsfile);
	}
	
	return $Swignition::uF::SGNM;
}

# Cleans away nested compound microformats. Any intentionally
# nested microformats (e.g. vcard class="agent vcard") should be
# dealt with BEFORE calling the destroyer! Because of the
# destructive nature of this function, make sure that you only
# use it on a clone of the real node.
sub destroyer
{
	my $element = shift;
	
	# Classes to be destroyed
	my @containers = qw(mfo vcard adr geo vcalendar vevent vtodo valarm
		vfreebusy hfeed hentry hslice hreview hresume xfolkentry biota haudio
		hmeasure hangle hmoney hlisting vtodo-list figure hproduct);
	my %C;
	foreach my $c (@containers) { $C{$c}=1; }
	
	# Some classes may be retained, optionally.
	foreach my $c (@_)          { $C{$c}=0; }

	# Assemble them all into the regular expression of death.
	@containers = ();
	foreach my $c (keys %C) { push @containers, $c if $C{$c}; }
	my $regexp = join '|', @containers;
	$regexp = "\\b($regexp)\\b";
	$regexp =~ s/\-/\\\-/g;
	
	# Destroy child elements matching the regular expression.
	foreach my $e ($element->getElementsByTagName('*'))
	{	
		next if ($e == $element);
		if ($e->getAttribute('class') =~ /$regexp/)
		{
			destroy_element($e);
			my $newclass = $e->getAttribute('class');
			$newclass =~ s/$regexp//g;
			$e->setAttribute('class', $newclass);
			$e->removeAttribute('class') if (!length $newclass);
		}
	}
}


sub destroy_element
{
	my $element = shift;
	foreach my $c ($element->getElementsByTagName('*'))
	{
		$c->removeAttribute('class');
		$c->removeAttribute('rel');
		$c->removeAttribute('rev');
	}
}


sub data_patterns
{
	my $page = shift;
	my $root = shift;
	my $max_include_loops = shift || 2;

	# Expand microformat include pattern.
	my $incl_iterations = 0;
	my $replacements = 1;
	while (($incl_iterations < $max_include_loops) && $replacements)
	{
		$replacements = ufp_include($root, $page) + ufp_include2($root, $page);
		$incl_iterations++;
	}
	
	# Table cell headers pattern.
	Swignition::uF::ufp_table($root, $page);	

	# Magical data-X class pattern.
	Swignition::uF::ufp_data_class($root, $page);
}


sub ufp_data_class
{
	my $node = shift;
	my $page = shift;
	
	return
		unless ($page->{Profiles}->{'http://purl.org/uF/pattern-data-class/1'});
		
	foreach my $kid ($node->getElementsByTagName('*'))
	{
		my $classes = $kid->getAttribute('class');
		$classes =~ s/(^\s+|\s+$)//g;
		$classes =~ s/\s+/ /g;
		my @classes = split / /, $classes;
		map s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg, @classes;
		my @dataClasses = grep /^data\-/, @classes;
		next unless (@dataClasses);
		
		my $val = '';
		foreach my $d (@dataClasses)
		{
			$val = $d unless ((length $val) > (length $d));
		}
		
		$val =~ s/^data\-//;
		$kid->setAttribute('microformats-content', $val);
	}
}


sub ufp_table
{
	my $node = shift;
	my $page = shift;
	
	# Add node itself to list!
	my @elements = $node->getElementsByTagName('td');
	if (('XML::LibXML::Element' eq ref $node) && $node->tagName =~ /^t[dh]$/i)
		{ unshift @elements, $node; }
		
	foreach my $tag (@elements)
	{
		next unless (length $tag->getAttribute('headers'));
		
		my $headers = $tag->getAttribute('headers');
		$headers =~ s/(^\s+|\s+$)//g;
		$headers =~ s/\s+/ /g;
		my @headers = split / /, $headers;
		
		foreach my $H (@headers)
		{
			my $Htag = searchID($H, $page->{DOM});
			next unless ($Htag);
			next unless ($Htag->tagName =~ /^t[dh]$/i);
			
			my $new = $page->{DOM}->createElement('div');
			$new->setAttribute('class', $Htag->getAttribute('class'));
			foreach my $kid ($Htag->childNodes)
			{
				my $x = $kid->cloneNode(1);
				if ($kid->nodeType==XML_ELEMENT_NODE || $kid->nodeType==XML_TEXT_NODE)
				{
					my $r = $new->appendChild($x);
				}
			}
			$tag->appendChild($new);
		}
		
		$tag->setAttribute('headers', '');
	}
}

sub ufp_include
# Implements the standard microformats include pattern.
{
	my $node  = shift;
	my $page  = shift;
	my $class = shift || 'include';
	my $rv = 0;
	
	# For each link...
	my @links1 = $node->getElementsByTagName('a');
	my @links2 = $node->getElementsByTagName('object');
	my @links = (@links1, @links2);
	foreach my $link (@links)
	{	
		# Skip pattern if no class attribute found.
		my $classList = $link->getAttribute('class') || next;
		
		# We've found a use of the include pattern
		if ($classList =~ / (^|\s) $class (\s|$) /x)
		{
			my $href = length $link->getAttribute('href') ?
				$link->getAttribute('href') :
				$link->getAttribute('data') ;
				
			my $id = undef;
			if ($href =~ /^\#(.*)$/)
			{
				$id = $1;
			}
			else
			{
				next;
			}

			# find the included node
			my $replacement = searchID($id, $page->{DOM});
			next unless $replacement;

			# do not include it if it's an ancestor
			my $link_xpath = $link->getAttribute('_xpath');
			my $repl_xpath = $replacement->getAttribute('_xpath');
			next if (substr($link_xpath, 0, length $repl_xpath) eq $repl_xpath);

			# replace the including element with the included element
			$replacement = $replacement->cloneNode(1);
			$link->getParentNode->replaceChild($replacement, $link) && $rv++;
		}
	}
	
	# Return number of replacements made.
	return $rv;
	
} # /sub ufp_include


sub ufp_include2
# Implements the alternative microformats include pattern.
{
	my $node = shift;
	my $page = shift;
	my $classpfx = shift || '#';
	my $rv = 0;
	
	# Add node itself to list!
	my @elements = $node->getElementsByTagName('*');
	unshift @elements, $node;
	
	# For each element...
	foreach my $elem (@elements)
	{
		# Skip pattern if no class attribute found.
		my $classList;
		$classList = $elem->getAttribute('class')
			if ('XML::LibXML::Element' eq ref $elem);
		next unless ($classList =~ / $classpfx /x);

		my $atEnd = 0;
		
		$classList =~ s/(^\s|\s$)//g;
		$classList =~ s/\s+/ /g;
		my @classes = split / /, $classList;
		my @newClassList = ();
		
		foreach my $c (@classes)
		{
			if (substr($c,0,1) ne $classpfx && length($c)>=1)
			{
				push @newClassList, $c;
				$atEnd = 1;
				next;
			}
			
			my $id = $c; $id =~ s/^\#//x;
			my $replacement = searchID($id, $page->{DOM}) || next;

			# do not include it if it's an ancestor
			my $link_xpath = $elem->getAttribute('_xpath');
			my $repl_xpath = $replacement->getAttribute('_xpath');
			next if (substr($link_xpath, 0, length $repl_xpath) eq $repl_xpath);

			$replacement = $replacement->cloneNode(1);
			if ($atEnd)
			{
				$elem->appendChild($replacement) && $rv++;
			}
			else
			{
				$elem->insertBefore($replacement, $elem->getFirstChild) && $rv++;
			}
		}
		
		$elem->setAttribute('class', join(' ', @newClassList))
			if ('XML::LibXML::Element' eq ref $elem);
	}
	
	# Return number of replacements made.
	return $rv;
	
} # /sub ufp_include2


sub datetime
# Very tolerant DateTime parsing. Microformats are supposed to always use W3CDTF,
# but we'll be lenient and do our best to parse other ISO 8601 formats, and if
# that fails, even try to parse natural language.
{
	my $string = shift;
	my $tz     = shift || 'UTC';
	my $base   = shift || undef;
	my $f;
	my $dt;
	
	$string = $string->{string} if (isms($string));
	
	if ($base)
		{ $f = Swignition::DTParse->new(base_datetime => $base); }
	else
		{ $f = Swignition::DTParse->new; }
		
	eval {
		my $isostring = $string;
		$isostring =~ s/([\+\-]\d\d)([014][50])$/\1\:\2/;	
		$dt = $f->parse_datetime($isostring);
		$dt->{resolution} = $f->{resolution};
		
		if ($dt->{resolution} eq 'end')
		{
			$dt = $dt->add( days => 1 );
			$dt->{resolution} = 'day';
		}
	};
	
	unless ($dt)
	{
		eval {
			my $time = str2time($string);
			$dt = DateTime->from_epoch( epoch => $time );
			$dt->{resolution} = 'second' unless ($dt->{resolution});
		};
	}

	unless ($dt)
	{
		$f = DateTime::Format::Natural->new(
			lang          => 'en',        # Should read this from source input
			prefer_future => 1,
			daytime       => {
										morning    =>  9,
										afternoon  => 13,
										evening    => 20
								  },
			time_zone     => "$tz"
		);
		$dt = $f->parse_datetime($string);
		$dt->{resolution} = 'second' unless ($dt->{resolution});
	}
	return undef unless ($dt);
	
	my %pattern = (
	   year          => '%Y',
	   month         => '%Y-%m',
	   week          => '%F',
	   day           => '%F',
	   hour          => '%FT%H:%M',
	   minute        => '%FT%H:%M',
	   second        => '%FT%H:%M:%S',
		nanosecond    => '%FT%T.%9N'
	);	
	my %tz_pattern = (
	   year          => '%Y',
	   month         => '%Y-%m',
	   week          => '%F',
	   day           => '%F',
	   hour          => '%FT%H:%M%z',
	   minute        => '%FT%H:%M%z',
	   second        => '%FT%H:%M:%S%z',
		nanosecond    => '%FT%T.%9N%z'
	);
	
	if ($dt->year >= 100000)
	{
		foreach my $x (keys %pattern)
		{
			$pattern{$x}    = '+'.$pattern{$x};
			$tz_pattern{$x} = '+'.$tz_pattern{$x};
		}
	}
	elsif ($dt->year >= 10000)
	{
		foreach my $x (keys %pattern)
		{
			$pattern{$x}    = '+0'.$pattern{$x};
			$tz_pattern{$x} = '+0'.$tz_pattern{$x};
		}
	}

   if ($dt->{tz}->{name} eq 'floating')
   {
		$dt->set_formatter(DateTime::Format::Strptime->new(
			pattern => (  $pattern{$dt->{resolution}}  )
		));
	}
	else
	{
		$dt->set_formatter(DateTime::Format::Strptime->new(
			pattern => (  $tz_pattern{$dt->{resolution}}  )
		));
	}
	
	return $dt;
}

# FUNCTION: simple_parse({}, $node, [['class1','signals1'],['c2','s2']], {})
#
# PARAM 1: Hashref to add data to.
# 
# PARAM 2: Root element.
# 
# PARAM 3: Arrayref of parameters for each thing to parse...
# 
# 	Param 1: class name to search for
# 	
# 	Param 2: string of parsing codes
# 	1  = singular, required
# 	?  = singular, optional
# 	+  = plural, required
# 	*  = plural, optional
#  ** = plural, optional, and funny behaviour with embedded microformats
# 	d  = date
# 	D  = duration
#  i  = interval
# 	h  = HTML
# 	H  = HTML and Text (HTML value is prefixed 'html_')
# 	m  = embedded composite microformat
# 	M  = embedded composite microformat or text
#  MM = embedded composite microformat or text, if url use pseudo-microformat
# 	n  = numeric
# 	r  = rel, not class
#  R  = rel *or* class
#  t  = tag name, not class
#  T  = tag name *or* class
# 	u  = URI
# 	U  = URI or fragment or text
# 	&  = concatenate strings
#  <  = Also store node (as $rv->{'_class_'})
# 
# 	Param 3: Hashref of other options
# 	embedded = space-delimited string of other microformats to allow embedded, in order of preference
# 	use-key = key to set in $rv. otherwise just use class name
# 	concatenate-with = when concatenating, join which what char?
# 	
# PARAM 4: Hashref of other options
# 	rel-tag = Parse embedded rel-tags and give them this key in $rv.
# 	rel-license = Ditto rel-license.
# 	hmeasure = Ditto hmeasure.
# 	rel-me => Keep an eye open for rel-me.
# 	no-destroy => List of microformats not to destroy.
# 
# Example:
# 
# simple_uf_parse(
# 	$rv,
# 	$root,
# 	[
# 		['agent', 'MM*', {embedded=>'hCard'}],
# 		['rev', 'd?'],
# 		['fn', '1'],
# 		['uid', 'L?']
# 		['note', '*&']
# 	],
# 	{
# 		'rel-tag' => 'category',
# 		'rel-license' => 'license',
# 		'hmeasure' => 'measures',
# 		'rel-me' => '_has_rel_me',
# 		'no-destroy' => ['adr', 'geo']
# 	}
# );
#
# This was not simple to implement, but should be simple to use.

sub simple_parse
{
	my $this    = shift;
	my $root    = shift;
	my $classes = shift;
	my $options = shift || {};
	my $page    = $this->{'_page'};
	
	# So far haven't needed any more than this.
	my $uf_roots = {
		'hCard'     => 'vcard',
		'hEvent'    => 'vevent',
		'hAlarm'    => 'valarm',
		'hTodo'     => 'vtodo',
		'hFreebusy' => 'vfreebusy',
		'hCalendar' => 'vcalendar',
		'hMeasure'  => 'hmeasure|hangle|hmoney',
		'species'   => 'biota',
		'hAtom'     => 'hfeed'
	};
	
	# Derived from HTML::Tagset, but some modifications to the order of attrs.
	my $link_elements = {
		'a'       => ['href'],
		'applet'  => ['codebase', 'archive', 'code'],
		'area'    => ['href'],
		'base'    => ['href'],
		'bgsound' => ['src'],
		'blockquote' => ['cite'],
#		'body'    => ['background'],
		'del'     => ['cite'],
		'embed'   => ['src', 'pluginspage'],
		'form'    => ['action'],
		'frame'   => ['src', 'longdesc'],
		'iframe'  => ['src', 'longdesc'],
#		'ilayer'  => ['background'],
		'img'     => ['src', 'lowsrc', 'longdesc', 'usemap'],
		'input'   => ['src', 'usemap'],
		'ins'     => ['cite'],
		'isindex' => ['action'],
		'head'    => ['profile'],
		'layer'   => ['src'], # 'background'
		'link'    => ['href'],
		'object'  => ['data', 'classid', 'codebase', 'archive', 'usemap'],
		'q'       => ['cite'],
		'script'  => ['src', 'for'],
#		'table'   => ['background'],
#		'td'      => ['background'],
#		'th'      => ['background'],
#		'tr'      => ['background'],
		'xmp'     => ['href'],
	};
	
	foreach my $c (@$classes)
	{
		my $class         = $c->[0];
		my $type          = $c->[1];
		my $class_options = $c->[2] || {};
		my @try_ufs       = split / /, $class_options->{'embedded'};
		
		next unless ($type =~ /m/i && defined $try_ufs[0]);
		
		my @parsed_objects;
		my @matching_nodes = matching_nodes($class, $root, $type);
		my @ok_matching_nodes;
		
		if ($class_options->{'nesting-ok'})
		{
			@ok_matching_nodes = @matching_nodes;
		}
		else
		{
			# This is a little bit of extra code that checks for interleaving uF
			# root class elements and excludes them. For example, in the following,
			# the outer hCard should not have an agent:
			# <div class="vcard">
			#  <p class="birth vcard">
			#   <span class="agent vcard"></span>
			#  </p>
			# </div>
			my @mfos = qw(mfo vcard adr geo vcalendar vevent vtodo valarm
				vfreebusy hfeed hentry hslice hreview hresume xfolkentry biota haudio
				hmeasure hangle hmoney hlisting vtodo-list figure hproduct);
			my $mfos = '\b('.(join '|', @mfos).')\b';
			foreach my $u (@{$class_options->{'allow-interleaved'}})
				{ $mfos =~ s/\|$u//; }

			foreach my $mn (@matching_nodes)
			{
				my $is_ok = 1;
				my $ancestor = $mn->parentNode;
				while (length $ancestor->getAttribute('_xpath') > length $root->getAttribute('_xpath'))
				{
					if ($ancestor->getAttribute('class')=~$mfos)
					{
						$is_ok = 0;
						last;
					}
					$ancestor = $ancestor->parentNode;
				}
				push @ok_matching_nodes, $mn if ($is_ok);
			}
		}
		
		# For each matching node
		foreach my $node (@ok_matching_nodes)
		{
			my @node_parsed_objects;
			
			# Try each microformat until we find something
			no strict 'refs';
			foreach my $uf (@try_ufs)
			{				
				my $uf_class = (defined $uf_roots->{$uf}) ? $uf_roots->{$uf} : lc($uf);
				last if (defined $node_parsed_objects[0]);
				
				if ($uf eq '!person')
				{
					# This is used as a last-ditch attempt to parse a person.
					@node_parsed_objects = Swignition::uF::hCalendar::parsePerson($page, $node);
				}
				elsif ($node->getAttribute('class') =~ /\b($uf_class)\b/)
				{
					my $sub = 'Swignition::uF::'.$uf.'::parse';
					push @node_parsed_objects, &{$sub}($page, $node, $class_options->{'is-in-ical'});
				}
				else
				{
					my $sub = 'Swignition::uF::'.$uf.'::parse_all';
					@node_parsed_objects = &{$sub}($page, $node, $class_options->{'is-in-ical'});
				}
				
				push @{$this->{ERRORS}}, simple_parse_found_error('W', "Multiple embedded $uf objects found in a single $class property. This is weird.")
					if (defined $node_parsed_objects[1]);
			}
			use strict 'refs';
			
			# If we've found something
			if (defined $node_parsed_objects[0])
			{
				# Remove $class from $node's class list, lest we pick it up again
				# in the next giant loop!
				my $new_class_attr = $node->getAttribute('class');
				$new_class_attr =~ s/\b($class)\b//;
				$node->setAttribute('class', $new_class_attr);

				# If $type contains '**' then allow
				# <div class="agent">
				#   <p class="vcard"></p>
				#   <p class="vcard"></p>
				# </div>
				if ($type =~ /\*\*/)
				{
					foreach my $p (@node_parsed_objects)
					{
						# Record parent property node in case we need it (hResume does)!
						$p->{parent_property_node} = $node;		
						push @parsed_objects, $p;
					}
				}
				else
				{
					$node_parsed_objects[0]->{parent_property_node} = $node;
					push @parsed_objects, $node_parsed_objects[0];
				}
			}
		}
		
		# What key should we use to store everything in $this?
		my $object_key = $class;
		$object_key = $class_options->{'use-key'}
			if (defined $class_options->{'use-key'});

		# Actually do the storing!
		if ($type =~ /[1\?]/ && !defined $this->{$object_key})
		{
			$this->{$object_key} = $parsed_objects[0];
			$this->{'_'.$object_key.'_'} = $parsed_objects[0]->{parent_property_node}
				if ($type =~ /\</);
				
			push @{$this->{ERRORS}}, simple_parse_found_error('W', "$class is singular, but multiple instances found. Only the first one will be used.")
				if (defined $parsed_objects[1]);
		}
		else
		{
			foreach my $value (@parsed_objects)
			{
				push @{ $this->{$object_key} }, $value;
				push @{ $this->{'_'.$object_key.'_'} }, $parsed_objects[0]->{parent_property_node}
					if ($type =~ /\</);
			}
		}
	}
	
	# Destroy nested microformats.
	destroyer($root, 'hmeasure', 'hangle', 'hmoney', @{ $options->{'no-destroy'} });
	
	# hmeasure, and destroy each, unless saved by $options->{'no-destroy'}!
	my $do_destroy = {
		'hmeasure' => 1,
		'hangle'   => 1,
		'hmoney'   => 1
	};
	foreach my $root (@{ $options->{'no-destroy'} })
		{ $do_destroy->{$root} = 0; }
	if (defined $options->{'hmeasure'})
	{
		my @measures = Swignition::uF::hMeasure::parse_all($page, $root);
		foreach my $m (@measures)
		{
			push @{ $this->{$options->{'hmeasure'}} }, $m
				unless ($m->{item_dom} || $m->{item_object});
			destroy_element($m->{'_dom'})
				if ($do_destroy->{ $m->{class} });
		}
	}
	
	# rel-tag
	if (defined $options->{'rel-tag'})
	{
		my @tags = Swignition::uF::RelTag::parse_all($page, $root);
		foreach my $t (@tags)
			{ push @{ $this->{$options->{'rel-tag'}} }, $t; }
	}
	
	# rel-license
	if (defined $options->{'rel-license'})
	{
		my @licenses = Swignition::uF::RelLicense::parse_all($page, $root);
		foreach my $l (@licenses)
			{ push @{ $this->{$options->{'rel-license'}} }, $l; }
	}
	
	# rel-enclosure
	if (defined $options->{'rel-enclosure'})
	{
		my @attachments = Swignition::uF::RelEnclosure::parse_all($page, $root);
		foreach my $a (@attachments)
			{ push @{ $this->{$options->{'rel-enclosure'}} }, $a; }
	}
	
	# For each of the classes that we're looking for...
	foreach my $c (@$classes)
	{
		my $class         = $c->[0];
		my $type          = $c->[1];
		my $class_options = $c->[2] || {};
		
		# We've already processed embedded microformats.
		next if ($type =~ /m/);

		my @matching_nodes = matching_nodes($class, $root, $type);
		
		# Parse each node that matched.
		my @parsed_values;
		my @parsed_values_nodes;
		my @parsed_values_alternatives;
		foreach my $node (@matching_nodes)
		{
			# Jump out of the loop if we were only expecting a single value and
			# have already found it!
			if ($type =~ /[1\?]/ && defined $parsed_values[0])
			{
				push @{$this->{ERRORS}}, simple_parse_found_error('W', "$class is singular, but multiple instances found. Only the first one will be used.");
				last;
			}
			
			# Avoid conflicts between rel=tag and class=category.
			next
				if (($class eq $options->{'rel-tag'})
				&&  ($node->getAttribute('rel') =~ /\b(tag)\b/i));

			# Ditto rel=license and class=license.
			next
				if (($class eq $options->{'rel-license'})
				&&  ($node->getAttribute('rel') =~ /\b(license)\b/i));

			# Ditto rel=enclosure and class=attach.
			next
				if (($class eq $options->{'rel-enclosure'})
				&&  ($node->getAttribute('rel') =~ /\b(enclosure)\b/i));
			
			# Parse URL types
			my ($u, $u_element);
			if ($type =~ /(u|U|MM)/)
			{
				my @value_elements = searchClass('value', $node);
				unshift @value_elements, $node;
				ELEMENT: foreach my $v (@value_elements)
				{
					if (defined $link_elements->{lc $v->tagName})
					{
						ATTR: foreach my $attr (@{ $link_elements->{lc $v->tagName} })
						{
							if (length $v->getAttribute($attr))
							{
								$u = $v->getAttribute($attr);
								$u_element = $v;
								last ELEMENT;
							}
						}
					}
					if ($type =~ /U/ && length $v->getAttribute('id'))
					{
						$u = '#'.$v->getAttribute('id');
						$u_element = $v;
						last ELEMENT;
					}
				}

				if (defined $u)
				{
					if ($type =~ /MM/)
					{
						my $px = { uri => $page->uri($u) };
						bless $px, "Swignition::uF::Pseudo";
						push @parsed_values, $px;
					}
					else
					{
						push @parsed_values, $page->uri($u);
					}
					push @parsed_values_nodes, $node;
					if (length $options->{'rel-me'} && $u_element->getAttribute('rel') =~ /\b(me)\b/i)
						{ $this->{$options->{'rel-me'}}++; }
					next;
				}
				else
				{
					push @parsed_values, STRINGIFY($node, 'value');
					push @parsed_values_nodes, $node;
					next;
				}
			}							
			
			# Extract text (and if needed, XML) string from node.
			if ($type =~ /H/)
			{
				push @parsed_values, STRINGIFY($node, 'value');
				push @parsed_values_alternatives, XML_STRINGIFY($node, undef, $class_options->{'include-self'});
				push @parsed_values_nodes, $node;
			}
			elsif ($type =~ /h/)
			{
				push @parsed_values, XML_STRINGIFY($node, undef, $class_options->{'include-self'});
				push @parsed_values_nodes, $node;
			}
			elsif ($type =~ /d/)
			{
				push @parsed_values, STRINGIFY($node, {
					'excerpt-class' => 'value',
					'abbr-pattern'  => 1,
					'datetime'      => 1,
					'joiner'        => ' '
				});
				push @parsed_values_nodes, $node;
			}
			elsif ($type =~ /u/)
			{
				push @parsed_values, $page->uri(STRINGIFY($node, 'value'));
				push @parsed_values_nodes, $node;
			}
			else
			{
				push @parsed_values, STRINGIFY($node, 'value');
				push @parsed_values_nodes, $node;
			}

		}
		
		# Now we have parsed values in @parsed_values. Sometimes these need to be
		# concatenated.
		if ($type =~ /\&/)
		{
			my $joiner = ($type =~ /u/i) ? ' ' : '';
			$joiner = $class_options->{'concatenate-with'}
				if (defined $class_options->{'concatenate-with'});
				
			my $value = join $joiner, @parsed_values;
			@parsed_values = ($value);
			$value = join $joiner, @parsed_values_alternatives;
			@parsed_values_alternatives = ($value);
		}
		
		# Check which values are acceptable.
		my @acceptable_values;
		my @acceptable_values_nodes;
		for (my $i=0; defined $parsed_values[$i]; $i++)
		{
			my $value = $parsed_values[$i];
		
			# Check date values are OK
			if ($type =~ /d/)
			{
				$value = datetime($value);
				if ($value)
				{
					if ($parsed_values_nodes[$i]->getAttribute('class') =~ /\b(approx)\b/)
					{
						$value->{datatype} = 'http://dbpedia.org/resource/Approximation';
					}
					else
					{
						my @approx = searchClass('approx', $parsed_values_nodes[$i]);
						$value->{datatype} = 'http://dbpedia.org/resource/Approximation'
							if (@approx);						
					}
				
					push @acceptable_values, $value;
					push @acceptable_values_nodes, $parsed_values_nodes[$i];
					next;
				}
			}
			# Check durations are OK
			elsif ($type =~ /D/)
			{
				my $D = undef;
				if (&isms($value))
				{
					$D = Swignition::MagicDuration->parse($value->{string}, $value->{dom}, $page)
				}
				else
				{
					$D = Swignition::MagicDuration->parse($value, undef, $page)
				}
				if (defined $D)
				{
					push @acceptable_values, $D;
					push @acceptable_values_nodes, $parsed_values_nodes[$i];
				}
				else
				{
					push @{$this->{ERRORS}}, simple_parse_found_error('E', "$class could not be parsed as a duration.");
				}
				next;
			}
			# Check intervals are OK
			elsif ($type =~ /i/)
			{
				my $D;
				if (&isms($value))
				{
					$D = Swignition::MagicInterval->parse($value->{string}, $value->{dom}, $page)
				}
				else
				{
					$D = Swignition::MagicInterval->parse($value, undef, $page)
				}
				if ($D)
				{
					push @acceptable_values, $D;
					push @acceptable_values_nodes, $parsed_values_nodes[$i];
				}
				else
				{
					push @{$this->{ERRORS}}, simple_parse_found_error('E', "$class could not be parsed as an interval.");
				}
				next;
			}
			# Everything else we won't bother to check if it's OK.
			else
			{
				push @acceptable_values, $value;
				push @acceptable_values_nodes, $parsed_values_nodes[$i];
				next;
			}
		}
		
		# What key should we use to store everything in $this?
		my $object_key = $class;
		$object_key = $class_options->{'use-key'}
			if (defined $class_options->{'use-key'});
		
		# Actually do the storing!
		if ($type =~ /[1\?\&]/ && !defined $this->{$object_key})
		{
			$this->{    $object_key    } = $acceptable_values[0];
			$this->{'_'.$object_key.'_'} = $acceptable_values_nodes[0]
				if ($type =~ /\</);			
		}
		else
		{
			for (my $i=0; defined $acceptable_values[$i]; $i++)
			{
				push @{ $this->{    $object_key    } }, $acceptable_values[$i];
				push @{ $this->{'_'.$object_key.'_'} }, $acceptable_values_nodes[$i]
					if ($type =~ /\</);	
			}
		}
		
		if ($type =~ /[1\+]/ && !defined $this->{$object_key})
		{
			push @{$this->{ERRORS}}, simple_parse_found_error('E', "$class is required, but no acceptable value was found.");
		}

		# Store HTML values too!
		if ($type =~ /[1\?\&]/ && defined $parsed_values_alternatives[0])
		{
			$this->{'html_'.$object_key} = $parsed_values_alternatives[0];
		}
		else
		{
			foreach my $value (@parsed_values_alternatives)
			{
				push @{ $this->{'html_'.$object_key} }, $value;
			}
		}	
	}
}


sub simple_parse_found_error
{
	my $EARL = 'http://www.w3.org/WAI/ER/EARL/nmg-strawman#';
	my $XE   = 'http://buzzword.org.uk/rdf/xearl#';
	my $DC   = 'http://purl.org/dc/terms/';
	
	my $elevel      = shift;
	my $description = shift;

	my $p = Swignition::RDFModel::Subject->new(
		Swignition::GenericParser::Utils::BNodeURI(undef, 'MicroformatErrorReport'));		
	$p->addVal('http://www.w3.org/1999/02/22-rdf-syntax-ns#type',
		Swignition::RDFModel::Value->new($EARL.'Assertion', 1));
	$p->addVal($EARL.'assertedBy',
		Swignition::RDFModel::Value->new('http://buzzword.org.uk/swignition/#swignition', 1));
	$p->addVal($EARL.'mode',
		Swignition::RDFModel::Value->new($EARL.'automatic', 1));
	$p->addVal($EARL.'result',
		Swignition::RDFModel::Value->new($XE.($elevel eq 'E'?'error':'warning'), 1));
	$p->addVal($DC.'abstract',
		Swignition::RDFModel::Value->new(strlang($description, 'en')));

	return $p;
}

sub error_list_process
{
	my $EARL = 'http://www.w3.org/WAI/ER/EARL/nmg-strawman#';
	my $XE   = 'http://buzzword.org.uk/rdf/xearl#';
	my $DC   = 'http://purl.org/dc/terms/';

	my ($this, $page, $specification) = (shift, shift, shift);
	
	while (my $error = shift @{ $this->{ERRORS} })
	{
		$error->addVal($XE.'complianceWith',
			Swignition::RDFModel::Value->new($specification, 1));
		$error->addVal($EARL.'subject',
			Swignition::RDFModel::Value->new($page->uri, 1));
		$error->addVal($XE.'itemOnPage',
			Swignition::RDFModel::Value->new($this->uri, 1));
		
		$page->mergeSubject($error);
	}
}


# &matching_nodes($class_name, $tag, $type)
sub matching_nodes
{
	my $class = shift;
	my $root  = shift;
	my $type  = shift;
	my @matching_nodes;
	
	if ($type =~ /r/i)
		{ @matching_nodes = searchRel($class, $root); }
	elsif ($type =~ /t/i)
		{ @matching_nodes = $root->getElementsByTagName($class); }
	
	if ($type !~ /[rt]/)
	{
		my @mn2 = searchClass($class, $root);
		push @matching_nodes, @mn2;
	}
	
	return @matching_nodes;
}


sub UIDURI
{
	my $this = shift;
	my $pfx  = shift || undef;
	
	return 'urn:x-'.$pfx.'-uid:'. $this->{uid}
		if ($pfx);
	return 'urn:x-uid:'.$this->{uid};
}


sub TDBURI
{
	my $this = shift;
	my $pfx  = shift || undef;
	return 'http://thing-described-by.org?'.$this;
}


1; #/package Swignition::uF


package Swignition::uF::Pseudo;

sub uri
{
	my $this = shift;
	my $all  = shift;
	my @rv   = ($this->{uri});

	unless (defined $all) { return $rv[0];}
	while ($all) { shift @rv; $all--; }
	return @rv;
}

1;
